grafica <- function(f,i,d,t,color="red"){
#f_a <- function(x){sqrt(x)-cos(x)}
x <- seq(i, d, by=0.0001)
y <- f(x)
graf_a <- ggplot()+
geom_vline(xintercept = 0, linetype="dashed")+ #eje x
geom_hline(yintercept = 0, linetype="dashed")+ #eje y
geom_line(aes(x=x, y=y), color=color, linewidth=1)+
#coord_fixed(ratio = 1)+ # misma escala en los ejes
labs(x="x", y="f(x)", title=t)+
theme_bw()
ggplotly(graf_a)
}graficas <- function(g,i,d,t){
f <- function(x){x}
#g <- function(x){(2-exp(x)+x^2)/3}
h <<- function(x){g(x)-f(x)}
graf <- ggplot()+
#geom_vline(xintercept = 0, linetype="dashed")+ #eje x
#geom_hline(yintercept = 0, linetype="dashed")+ #eje y
#geom_line(aes(x=x_a, y=y_a), color="red", linewidth=1)+
geom_function(fun=f,color="red",linewidth=0.75,n=200)+
geom_function(fun=g,color="blue",linewidth=0.75,n=200)+
geom_function(fun=h,color="yellow",linewidth=0.75,n=200)+
#coord_fixed(ratio = 1)+ # misma escala en los ejes
xlim(i,d)+
labs(x="x", y="f(x)", title=t)+
theme_bw()
ggplotly(graf)
}Ejercicio 1
Sea \(f(x)=\sqrt{x}-\cos x\). Usa el método de la bisección para encontrar \(x\in [0,1]\) tal que \(f(x)=0\).
f <- function(x){sqrt(x)-cos(x)}
grafica(f,0,1.5,"Primera gráfica")Otra opción
graf_a <- ggplot()+
#geom_vline(xintercept = 0, linetype="dashed")+ #eje x
#geom_hline(yintercept = 0, linetype="dashed")+ #eje y
geom_function(fun=f, color="red", linewidth=1, n=200)+
#coord_fixed(ratio = 1)+ # misma escala en los ejes
xlim(0, 1.5)+
labs(x="x", y="f(x)", title="Primera gráfica")+
theme_bw()
ggplotly(graf_a)Utilizando la función desarrollada en clase
metodo_biseccion(f,0,1,1e-10,N=500)## $aprox
## [1] 0.5000000 0.7500000 0.6250000 0.6875000 0.6562500 0.6406250 0.6484375
## [8] 0.6445312 0.6425781 0.6416016 0.6420898 0.6418457 0.6417236 0.6416626
## [15] 0.6416931 0.6417084 0.6417160 0.6417122 0.6417141 0.6417150 0.6417146
## [22] 0.6417143 0.6417145 0.6417144 0.6417144 0.6417144 0.6417144 0.6417144
## [29] 0.6417144 0.6417144 0.6417144 0.6417144 0.6417144 0.6417144
##
## $precision
## [1] 5.820766e-11
##
## $iteraciones
## [1] 34
La raíz es 0.6417144 Utiliando la función de pracma:
bisect(f,0,1,500)## $root
## [1] 0.6417144
##
## $f.root
## [1] -2.220446e-16
##
## $iter
## [1] 54
##
## $estim.prec
## [1] 1.110223e-16
Ejercicio 2
Usa el método de la bisección para encontrar una raíz con una precisión de \(10^{-2}\) para \(x^3-7x^2+14x-6=0\) en cada intervalo.
\[\begin{equation} a) [0,1]\qquad\qquad b) [1, 3.2]\qquad\qquad c)[3.2, 4] \end{equation}\]
f <- function(x){x^3-7*x^2+14*x-6}
grafica(f,-1,5,"Segunda gráfica")bisect(f,0,1,500)## $root
## [1] 0.5857864
##
## $f.root
## [1] -8.881784e-16
##
## $iter
## [1] 54
##
## $estim.prec
## [1] 1.110223e-16
Entre 0 y 1, la raíz es de 0.5857864
bisect(f,1,3.2,500)## $root
## [1] 3
##
## $f.root
## [1] 7.105427e-15
##
## $iter
## [1] 54
##
## $estim.prec
## [1] 4.440892e-16
Entre 1 y 3.2, la raíz es de 3
bisect(f,3.2,4,500)## $root
## [1] 3.414214
##
## $f.root
## [1] -2.131628e-14
##
## $iter
## [1] 52
##
## $estim.prec
## [1] 4.440892e-16
Entre 3.2 y 4, la raíz es de 3.414214
Ejercicio 3
Usa el metodo de la bisección para encontrar las soluciones con una precisión de \(10^{-5}\) para los siguientes problemas.
- \(x-2^{-x}=0\) para \(0\leq x\leq 1\)
f <- function(x){x-2^(-x)}
grafica(f,-1,2,"Gráfica 3.a)")bisect(f,0,1,500)## $root
## [1] 0.6411857
##
## $f.root
## [1] 0
##
## $iter
## [1] 54
##
## $estim.prec
## [1] 1.110223e-16
La raíz está en 0.6411857
- \(e^x-x^2+3x-2=0\) para \(0\leq x\leq 1\)
f <- function(x){exp(x)-x^2+3*x-2}
grafica(f,-1,1,"Gráfica 3.b)")bisect(f,0,1,500)## $root
## [1] 0.2575303
##
## $f.root
## [1] -4.440892e-16
##
## $iter
## [1] 55
##
## $estim.prec
## [1] 5.551115e-17
La raíz está en 0.2575303
- \(2x\cos (2x)-(x+1)^2=0\) para \(-3\leq x\leq -2\) y \(-1\leq x \leq 0\)
f <- function(x){2*x*cos(2*x)-(x+1)^2}
grafica(f,-4,1,"Gráfica 3.c)")bisect(f,-3,-2,500)## $root
## [1] -2.191308
##
## $f.root
## [1] -3.108624e-15
##
## $iter
## [1] 52
##
## $estim.prec
## [1] 4.440892e-16
La raíz entre -3 y -2 es de -2.191308
bisect(f,-1,0,500)## $root
## [1] -0.79816
##
## $f.root
## [1] 4.857226e-17
##
## $iter
## [1] 54
##
## $estim.prec
## [1] 1.110223e-16
La raíz entre -1 y 0 es de -0.79816
- \(x\cos x-2x^2+3x-1=0\) para \(0.2\leq x\leq 0.3\) y \(1.2\leq x \leq 1.3\)
f <- function(x){x*cos(x)-2*x^2+3*x-1}
grafica(f,0.1,1.4,"Gráfica 3.d)")bisect(f,0.2,0.3,500)## $root
## [1] 0.2975302
##
## $f.root
## [1] 0
##
## $iter
## [1] 52
##
## $estim.prec
## [1] 5.551115e-17
La raíz entre 0.2 y 0.3 es de 0.2975302
bisect(f,1.2,1.3,500)## $root
## [1] 1.256623
##
## $f.root
## [1] 8.881784e-16
##
## $iter
## [1] 49
##
## $estim.prec
## [1] 2.220446e-16
La raíz entre 1.2 y 1.3 es de 1.256623
Ejercicio 4
Considera las funciones \(f(x)=x\) y \(g(x)=2 \sin x\). Usa el método de la bisección para encontrar una aproximación con una precisión de \(10^{-5}\) para el primer valor positivo \(x\) tal que \(f(x)=g(x)\).
g <- function(x){2*sin(x)}
graficas(g,-5,5,"Gráfica 4")bisect(h,1,2.5,500)## $root
## [1] 1.895494
##
## $f.root
## [1] 0
##
## $iter
## [1] 53
##
## $estim.prec
## [1] 2.220446e-16
La raíz está en 1.895494 cuando f(x)=g(x) en su valor positivo
Ejercicio 5
Sea \(f(x)=(x+2)(x+1)x(x-1)^3(x-2)\). ¿A cuál raíz de \(f\) converge el método de la bisección cuando se aplica a los siguientes intervalos?
\[\begin{equation} a) [-3,2.5]\qquad \qquad b) [-2.5, 3]\qquad\qquad c)[-1.75, 1.5]\qquad\qquad d) [-1.5, 1.75] \end{equation}\]
f <- function(x){(x+2)*(x+1)*x*(x-2)*(x-1)^3}
grafica(f,-4,4,"Gráfica 5")#bisect(f,-3,2.5)
metodo_biseccion(f,-3,2.5,1e-10,N=500)## $aprox
## [1] -0.250000 1.125000 1.812500 2.156250 1.984375 2.070312 2.027344
## [8] 2.005859 1.995117 2.000488 1.997803 1.999146 1.999817 2.000153
## [15] 1.999985 2.000069 2.000027 2.000006 1.999995 2.000000 1.999998
## [22] 1.999999 2.000000 2.000000 2.000000 2.000000 2.000000 2.000000
## [29] 2.000000 2.000000 2.000000 2.000000 2.000000 2.000000 2.000000
## [36] 2.000000
##
## $precision
## [1] 8.003553e-11
##
## $iteraciones
## [1] 36
La raíz está en 2
#bisect(f,-2.5,3,500)
metodo_biseccion(f,-2.5,3,1e-10,N=500)## $aprox
## [1] 0.250000 -1.125000 -1.812500 -2.156250 -1.984375 -2.070312 -2.027344
## [8] -2.005859 -1.995117 -2.000488 -1.997803 -1.999146 -1.999817 -2.000153
## [15] -1.999985 -2.000069 -2.000027 -2.000006 -1.999995 -2.000000 -1.999998
## [22] -1.999999 -2.000000 -2.000000 -2.000000 -2.000000 -2.000000 -2.000000
## [29] -2.000000 -2.000000 -2.000000 -2.000000 -2.000000 -2.000000 -2.000000
## [36] -2.000000
##
## $precision
## [1] 8.003553e-11
##
## $iteraciones
## [1] 36
La raíz está en -2
#bisect(f,-1.75,1.5)
metodo_biseccion(f,-1.75,1.5,1e-10,N=500)## $aprox
## [1] -0.1250000 -0.9375000 -1.3437500 -1.1406250 -1.0390625 -0.9882812
## [7] -1.0136719 -1.0009766 -0.9946289 -0.9978027 -0.9993896 -1.0001831
## [13] -0.9997864 -0.9999847 -1.0000839 -1.0000343 -1.0000095 -0.9999971
## [19] -1.0000033 -1.0000002 -0.9999987 -0.9999995 -0.9999999 -1.0000000
## [25] -0.9999999 -1.0000000 -1.0000000 -1.0000000 -1.0000000 -1.0000000
## [31] -1.0000000 -1.0000000 -1.0000000 -1.0000000 -1.0000000
##
## $precision
## [1] 9.458745e-11
##
## $iteraciones
## [1] 35
La raíz está en -1
#bisect(f,-1.5,1.75)
metodo_biseccion(f,-1.5,1.75,1e-10,N=500)## $aprox
## [1] 0.1250000 0.9375000 1.3437500 1.1406250 1.0390625 0.9882812 1.0136719
## [8] 1.0009766 0.9946289 0.9978027 0.9993896 1.0001831 0.9997864 0.9999847
## [15] 1.0000839 1.0000343 1.0000095 0.9999971 1.0000033 1.0000002 0.9999987
## [22] 0.9999995 0.9999999 1.0000000 0.9999999 1.0000000 1.0000000 1.0000000
## [29] 1.0000000 1.0000000 1.0000000 1.0000000 1.0000000 1.0000000 1.0000000
##
## $precision
## [1] 9.458745e-11
##
## $iteraciones
## [1] 35
La raíz está en 1
Ejercicio 6
En cada una de las siguientes ecuaciones, determina un intervalo \([a,b]\) en que convergerá la iteración de punto fijo. Estima la cantidad de iteraciones necesarias para obtener aproximaciones con una exactitud de \(10^{-5}\) y realiza los cálculos.
it_pf <- function(g, q0, pr=1e-5, N=100){
cond <- 1
it <- 1
q <- q0
while(cond==1){
if(it<=N){
q[it+1] = g(q[it]) # iteración de la función
pr_it <- abs(q[it+1]-q[it]) # precisión en la iteración
if(pr_it<pr){
resultados <- list(sucesion=q, precision=pr_it, iteraciones=it)
return(resultados)
cond <- 0
}#final del segundo if
else{it <- it+1}
}#final del primer if
else{
print("Se alcanzo el maximo de iteraciones")
cond <- 0
}#fin del else
}#final del while
}# final de la función- \(\quad x=\frac{2-e^{x}+x^{2}}{3}\)
g <- function(x){(2-exp(x)+x^2)/3}
graficas(g,-2,2,"6.a)")it_pf(g,0,pr=1e-10)## $sucesion
## [1] 0.0000000 0.3333333 0.2384996 0.2625130 0.2562399 0.2578654 0.2574433
## [8] 0.2575529 0.2575244 0.2575318 0.2575299 0.2575304 0.2575303 0.2575303
## [15] 0.2575303 0.2575303 0.2575303 0.2575303 0.2575303
##
## $precision
## [1] 3.945999e-11
##
## $iteraciones
## [1] 18
bisect(h,0,1)## $root
## [1] 0.2575303
##
## $f.root
## [1] 1.110223e-16
##
## $iter
## [1] 55
##
## $estim.prec
## [1] 5.551115e-17
- \(\quad x=\frac{5}{x^{2}}+2\)
g <- function(x){5/(x^2)+2}
graficas(g,-3,3,"6.b)")it_pf(g,0,pr=1e-10)## $sucesion
## [1] 0.000000 Inf 2.000000 3.250000 2.473373 2.817318 2.629939 2.722901
## [9] 2.674383 2.699074 2.686342 2.692863 2.689511 2.691231 2.690348 2.690801
## [17] 2.690569 2.690688 2.690627 2.690658 2.690642 2.690650 2.690646 2.690648
## [25] 2.690647 2.690648 2.690647 2.690647 2.690647 2.690647 2.690647 2.690647
## [33] 2.690647 2.690647 2.690647 2.690647 2.690647 2.690647 2.690647
##
## $precision
## [1] 9.914158e-11
##
## $iteraciones
## [1] 38
bisect(h,2,3)## $root
## [1] 2.690647
##
## $f.root
## [1] 4.440892e-16
##
## $iter
## [1] 52
##
## $estim.prec
## [1] 4.440892e-16
- \(\quad x=\left(e^{x} / 3\right)^{1 / 2}\)
g <- function(x){sqrt(exp(x)/3)}
graficas(g,-2,2,"6.c)")it_pf(g,1,pr=1e-10)## $sucesion
## [1] 1.0000000 0.9518897 0.9292650 0.9188121 0.9140225 0.9118362 0.9108400
## [8] 0.9103864 0.9101800 0.9100860 0.9100433 0.9100238 0.9100150 0.9100109
## [15] 0.9100091 0.9100083 0.9100079 0.9100077 0.9100076 0.9100076 0.9100076
## [22] 0.9100076 0.9100076 0.9100076 0.9100076 0.9100076 0.9100076 0.9100076
##
## $precision
## [1] 6.564504e-11
##
## $iteraciones
## [1] 27
bisect(h,0,2)## $root
## [1] 0.9100076
##
## $f.root
## [1] 0
##
## $iter
## [1] 55
##
## $estim.prec
## [1] 1.110223e-16
- \(\quad x=5^{-x}\)
g <- function(x){5^(-x)}
graficas(g,-2,2,"6.d)")it_pf(g,1,pr=1e-10)## $sucesion
## [1] 1.0000000 0.2000000 0.7247797 0.3114589 0.6057586 0.3772185 0.5449236
## [8] 0.4160205 0.5119342 0.4387058 0.4935803 0.4518582 0.4832420 0.4594395
## [15] 0.4773815 0.4637935 0.4740479 0.4662885 0.4721482 0.4677164 0.4710644
## [22] 0.4685329 0.4704457 0.4689997 0.4700925 0.4692664 0.4698907 0.4694188
## [29] 0.4697755 0.4695059 0.4697096 0.4695556 0.4696720 0.4695841 0.4696505
## [36] 0.4696003 0.4696383 0.4696096 0.4696313 0.4696149 0.4696273 0.4696179
## [43] 0.4696250 0.4696196 0.4696237 0.4696206 0.4696229 0.4696212 0.4696225
## [50] 0.4696215 0.4696222 0.4696217 0.4696221 0.4696218 0.4696220 0.4696218
## [57] 0.4696220 0.4696219 0.4696220 0.4696219 0.4696219 0.4696219 0.4696219
## [64] 0.4696219 0.4696219 0.4696219 0.4696219 0.4696219 0.4696219 0.4696219
## [71] 0.4696219 0.4696219 0.4696219 0.4696219 0.4696219 0.4696219 0.4696219
## [78] 0.4696219 0.4696219 0.4696219 0.4696219 0.4696219 0.4696219
##
## $precision
## [1] 9.706824e-11
##
## $iteraciones
## [1] 82
bisect(h,0,1)## $root
## [1] 0.4696219
##
## $f.root
## [1] 0
##
## $iter
## [1] 55
##
## $estim.prec
## [1] 5.551115e-17
- \(\quad x=6^{-x}\)
g <- function(x){6^(-x)}
graficas(g,-2,2,"6.e)")it_pf(g,0.5,pr=1e-10)## $sucesion
## [1] 0.5000000 0.4082483 0.4811950 0.4222382 0.4692830 0.4313471 0.4616860
## [8] 0.4372587 0.4568216 0.4410864 0.4536992 0.4435610 0.4516920 0.4451591
## [15] 0.4504005 0.4461905 0.4495690 0.4468557 0.4490334 0.4472848 0.4486884
## [22] 0.4475614 0.4484660 0.4477397 0.4483228 0.4478546 0.4482305 0.4479287
## [29] 0.4481710 0.4479765 0.4481326 0.4480073 0.4481079 0.4480271 0.4480920
## [36] 0.4480399 0.4480817 0.4480481 0.4480751 0.4480534 0.4480708 0.4480569
## [43] 0.4480681 0.4480591 0.4480663 0.4480605 0.4480651 0.4480614 0.4480644
## [50] 0.4480620 0.4480639 0.4480624 0.4480636 0.4480626 0.4480634 0.4480628
## [57] 0.4480633 0.4480629 0.4480632 0.4480630 0.4480632 0.4480630 0.4480631
## [64] 0.4480630 0.4480631 0.4480630 0.4480631 0.4480631 0.4480631 0.4480631
## [71] 0.4480631 0.4480631 0.4480631 0.4480631 0.4480631 0.4480631 0.4480631
## [78] 0.4480631 0.4480631 0.4480631 0.4480631 0.4480631 0.4480631 0.4480631
## [85] 0.4480631 0.4480631 0.4480631 0.4480631 0.4480631 0.4480631 0.4480631
## [92] 0.4480631 0.4480631 0.4480631 0.4480631 0.4480631
##
## $precision
## [1] 9.855849e-11
##
## $iteraciones
## [1] 95
bisect(h,-1,1)## $root
## [1] 0.4480631
##
## $f.root
## [1] 0
##
## $iter
## [1] 56
##
## $estim.prec
## [1] 5.551115e-17
- \(\quad x=0.5(\sin x+\cos x)\)
g <- function(x){0.5*(sin(x)+cos(x))}
graficas(g,-2,2,"6.f)")it_pf(g,0.75,pr=1e-10)## $sucesion
## [1] 0.7500000 0.7066638 0.7049162 0.7048179 0.7048123 0.7048120 0.7048120
## [8] 0.7048120 0.7048120
##
## $precision
## [1] 5.868017e-11
##
## $iteraciones
## [1] 8
bisect(h,0,1)## $root
## [1] 0.704812
##
## $f.root
## [1] 1.110223e-16
##
## $iter
## [1] 54
##
## $estim.prec
## [1] 1.110223e-16